home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tegl6b.zip / INTROPAK.EXE / lha / TSTPICK3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-26  |  5KB  |  147 lines
  1. {$I switches.inc}
  2. {$M 20000,0,655360}
  3.        {-- Defaults }
  4. {$A-}  {-- A- byte alignment }
  5. {$B-}  {-- B- short circuit boolean evaluation }
  6. {$D+}  {-- D- No debug info }
  7. {$E-}  {-- E- No emulation }
  8. {$F-}  {-- F- Far calls only when necessary }
  9. {$I-}  {-- I- I/O error checking done internally }
  10. {$L+}  {-- L- No local symbols }
  11. {$N-}  {-- N- Software reals }
  12. {$R-}  {-- R- Range checking off }
  13. {$S-}  {-- S- Stack overflow off }
  14. {$V-}  {-- V- No strict type checking }
  15.  
  16. uses virtmem,
  17.      errorlog,
  18.      teglfont,
  19.      {$IFNDEF TEGLDEMO}
  20.      teglfnt2,
  21.      {$ENDIF}
  22.      teglmain,
  23.      tegledit,
  24.      tgraph,
  25.      teglintr,
  26.      teglmenu,
  27.      teglpick,
  28.      teglunit,
  29.      fastgrph;
  30.  
  31. var pickeditem : string;
  32.     pickedms   : msclickptr;
  33.     pickedfs   : imagestkptr;
  34.  
  35.  
  36. {$F+}
  37. Function ExitOption(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  38. {$F+}
  39.    BEGIN
  40.       Abortexit(pickeditem);
  41.       exitoption := 1;
  42.    END;
  43.  
  44. {$F+}
  45. function droppicklist(fs:ImageStkPtr; Userkey:word; Var DataArea):Word;
  46. {$F-}
  47.    var picklist : optionmptr absolute DataArea;
  48.    begin
  49.       dropoptionmenu(picklist);
  50.       droppicklist := 0;
  51.    END;
  52.  
  53. {$F+}
  54. Function dropitems(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  55. {$F+}
  56.    var picklist : optionmptr;
  57.    begin
  58.       getuserdataarea(fs,222,picklist);
  59.       detachpicklist(picklist);
  60.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  61.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  62.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  63.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  64.       attachpicklist(picklist,picklist^.selectedoenum);
  65.  
  66.       getuserdataarea(fs,223,picklist);
  67.       detachpicklist(picklist);
  68.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  69.       deletePickItem(picklist,random(picklist^.numofentries)+1);
  70.       attachpicklist(picklist,picklist^.selectedoenum);
  71.  
  72.       beep(500,4,50);
  73.       dropitems := 1;
  74.    end;
  75.  
  76. {$F+}
  77. Function Additems(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  78. {$F+}
  79.    var picklist : optionmptr;
  80.    begin
  81.       getuserdataarea(fs,222,picklist);
  82.       detachpicklist(picklist);
  83.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item one on list',Additems,pickeditem);
  84.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item two on list',dropitems,pickeditem);
  85.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item three on list',Additems,pickeditem);
  86.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item four on list',dropitems,pickeditem);
  87.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item five on list',Additems,pickeditem);
  88.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item six on list',dropitems,pickeditem);
  89.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item seven on list',additems,pickeditem);
  90.       attachpicklist(picklist,picklist^.selectedoenum);
  91.  
  92.       getuserdataarea(fs,223,picklist);
  93.       detachpicklist(picklist);
  94.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item one on list',Additems,pickeditem);
  95.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item two on list',dropitems,pickeditem);
  96.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item three on list',Additems,pickeditem);
  97.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item four on list',dropitems,pickeditem);
  98.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item five on list',Additems,pickeditem);
  99.       insertPickItem(picklist,random(picklist^.numofentries)+1,'item six on list',dropitems,pickeditem);
  100.       attachpicklist(picklist,picklist^.selectedoenum);
  101.  
  102.       beep(500,4,50);
  103.       Additems := 1;
  104.    end;
  105.  
  106. procedure testpicklist;
  107.    var x,y,x1,y1 : word;
  108.        picklist1 : optionmptr;
  109.        picklist2 : optionmptr;
  110.    begin
  111.       x  := 100;
  112.       y  := 100;
  113.       x1 := x+200;
  114.       y1 := y+200;
  115.  
  116.       pushimage(x,y,x1,y1);
  117.       shadowbox(x,y,x1,y1);
  118.  
  119.       picklist1 := createpicklist(@font14);
  120.       DefinePickItem(picklist1,'item one on list',Additems,pickeditem);
  121.       DefinePickItem(picklist1,'item two on list',Additems,pickeditem);
  122.  
  123.       setuserdataarea(stackptr,222,picklist1,droppicklist);
  124.       definepicklistarea(stackptr,10,10,3,5,picklist1);
  125.  
  126.  
  127.       {$IFNDEF TEGLDEMO}
  128.       picklist2 := createpicklist(@roman25);
  129.       {$ELSE}
  130.       picklist2 := createpicklist(@f8x8bold);
  131.       {$ENDIF}
  132.       DefinePickItem(picklist2,'item one on list',Additems,pickeditem);
  133.       DefinePickItem(picklist2,'item two on list',Additems,pickeditem);
  134.  
  135.       setuserdataarea(stackptr,223,picklist2,droppicklist);
  136.       definepicklistarea(stackptr,10,picklist1^.y1+10,3,1,picklist2);
  137.    end;
  138.  
  139. begin
  140.    EasyTegl;
  141.    EasyOut;
  142.  
  143.    testpicklist;
  144.  
  145.    TEGLSupervisor;
  146. end.
  147.